home *** CD-ROM | disk | FTP | other *** search
/ The X-Philes (2nd Revision) / The X-Philes Number 1 (1995).iso / xphiles / hp48_1 / bin.dis < prev    next >
Text File  |  1995-03-23  |  4KB  |  189 lines
  1. Article 4950 of comp.sys.handhelds:
  2. Path: en.ecn.purdue.edu!noose.ecn.purdue.edu!samsung!olivea!uunet!stanford.edu!msi.umn.edu!noc.MR.NET!gacvx2.gac.edu!hhdist
  3. From: NORM%IONAACAD.BITNET@CUNYVM.CUNY.EDU (Norman Walsh)
  4. Newsgroups: comp.sys.handhelds
  5. Subject: HP48: Binary display & 2's complement arithmatic
  6. Message-ID: <FEA39044C00029DC@gacvx2.gac.edu>
  7. Date: 11 Mar 91 13:51:00 GMT
  8. Lines: 174
  9. Return-path: <@CUNYVM.CUNY.EDU:NORM@IONAACAD.BITNET>
  10. To: HANDHELDS@gac.edu
  11.  
  12. The following directory provides routines for displaying and converting
  13. binary numbers and performing 2's complement arithmatic.  The following
  14. entry points are provided through a custom menu:
  15.  
  16. BDISP      - displays the binary number in level 1 of the stack in binary,
  17.              octal, hexidecimal, and decimal form.  It's basically a mod
  18.              of BDISP from the manual.
  19. CONV       - converts the number in level 1 of the stack to or from binary
  20.              form.
  21. DEC/HEX/
  22. OCT/BIN    - select math base.
  23. \->2C      - convert number to 2's complement
  24. 2C\->      - convert number from 2's complement
  25. 2C+        - add 2's complement numbers
  26. 2C-        - subtract 2's complement numbers
  27. 2C*        - multiply 2's complement numbers
  28. 2C/        - integer division of 2's complement numbers.
  29.  
  30. The routines are sensitive to the current word size.  If you attempt to
  31. convert a number that is outside the current range of 2's complement numbers,
  32. the converted binary will be tagged "CF".  This is similar to setting the
  33. carry flag if a math operation exceeds the range of the destination.
  34. If you find these routines useful, please let me know.
  35.                                                           ndw
  36.  
  37.  
  38. %%HP: T(3)A(D)F(.);
  39. DIR
  40.   CST { BDISP CONV
  41. DEC HEX BIN OCT {
  42. "\->2C" \->TC } { "2C\->"
  43. TC\-> } { "2C+" TCS }
  44. { "2C-" TCM } {
  45. "2C*" TCP } { "2C/"
  46. TCD } { "WS4"
  47.     \<< 4 STWS
  48.     \>> } { "WS8"
  49.     \<< 8 STWS
  50.     \>> } { "WS16"
  51.     \<< 16 STWS
  52.     \>> } { "WS32"
  53.     \<< 32 STWS
  54.     \>> } { "WS64"
  55.     \<< 64 STWS
  56.     \>> } RCWS }
  57.   BDISP
  58.     \<<
  59.       IF DUP TYPE
  60. 10 \=/
  61.       THEN CONV
  62.       END DUP DUP
  63. DUP BIN 8 ZPAD
  64. CLLCD 1 DISP HEX 4
  65. ZPAD 2 DISP OCT 3
  66. ZPAD 3 DISP DEC 1
  67. ZPAD 5 DISP 0
  68. FREEZE
  69.     \>>
  70.   CONV
  71.     \<<
  72.       IF DUP TYPE
  73. 10 ==
  74.       THEN B\->R
  75.       ELSE R\->B
  76.       END
  77.     \>>
  78.   NEG2C
  79.     \<<
  80.       IF 2 RCWS 1 -
  81. ^ R\->B AND # 0d \=/
  82.       THEN 1
  83.       ELSE 0
  84.       END
  85.     \>>
  86.   OK
  87.     \<<
  88.       IF DUP TYPE 0
  89. ==
  90.       THEN
  91.         IF DUP FP 0
  92. ==
  93.         THEN 1
  94.         ELSE 0
  95.         END
  96.       ELSE 0
  97.       END
  98.       IF NOT 2 PICK
  99. TYPE 10 \=/ AND
  100.       THEN 0
  101.       ELSE 1
  102.       END
  103.     \>>
  104.   TCD
  105.     \<< TC\-> SWAP TC\->
  106. SWAP / IP \->TC
  107.     \>>
  108.   TCM
  109.     \<< TC\-> SWAP TC\->
  110. SWAP - \->TC
  111.     \>>
  112.   TCP
  113.     \<< TC\-> SWAP TC\->
  114. * \->TC
  115.     \>>
  116.   TCS
  117.     \<< TC\-> SWAP TC\->
  118. + \->TC
  119.     \>>
  120.   TC\->
  121.     \<<
  122.       IF DUP TYPE
  123. 12 ==
  124.       THEN DTAG
  125.       END
  126.       IF DUP TYPE
  127. 10 ==
  128.       THEN
  129.         IF DUP
  130. NEG2C
  131.         THEN NOT
  132. B\->R 1 + NEG
  133.         ELSE B\->R
  134.         END
  135.       END
  136.     \>>
  137.   ZPAD
  138.     \<< \-> len
  139.       \<<
  140.         IF DUP TYPE
  141. 10 \=/
  142.         THEN CONV
  143.         END \->STR
  144. DUP SIZE 3 SWAP 1 -
  145. SUB DUP SIZE len +
  146. 1 - len / IP len *
  147. 'len' STO
  148.         WHILE DUP
  149. SIZE len <
  150.         REPEAT "0"
  151. SWAP +
  152.         END # 0d
  153. \->STR 4 4 SUB + PAD
  154.       \>>
  155.     \>>
  156.   \->TC
  157.     \<< 0 \-> tag
  158.       \<<
  159.         IF DUP TYPE
  160. 10 ==
  161.         THEN B\->R
  162.         END
  163.         IF OK
  164.         THEN
  165.           IF DUP
  166. DUP TYPE 0 == SWAP
  167. ABS 2 RCWS 1 - ^ 1
  168. - > AND
  169.           THEN 1
  170. 'tag' STO
  171.           END
  172.           IF DUP 0
  173. <
  174.           THEN NEG
  175. 1 - R\->B NOT
  176.           ELSE R\->B
  177.           END
  178.         END
  179.         IF tag
  180.         THEN "CF"
  181. \->TAG
  182.         END
  183.       \>>
  184.     \>>
  185. END
  186. ***END OF POSTING***
  187.  
  188.  
  189.